home *** CD-ROM | disk | FTP | other *** search
/ Aminet 7 / Aminet 7 - August 1995.iso / Aminet / comm / bbs / WWBBSDoors.lha / WWBBS / rexxDoors / One_Armed_Bandit.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1995-04-27  |  8.7 KB  |  348 lines

  1. /***************************************/
  2. /* Bandit.rexx  Slot Machine Simulator */
  3. /* By: James M. Cates III Oct. 8 1990  */
  4. /* Arexx V1.10 By: William Hawes       */
  5. /* Original                            */
  6. /* Game Bye: M. Soucy and M. Fox.      */
  7. /* I found the code heavily 'munged'   */
  8. /* So, I did this. It works.           */
  9. /***************************************/
  10. /*  Altered again for BBBBS:rexxDoors  */
  11. /* By: Richard Lee Stockton 15 Mar 92  */
  12. /***************************************/
  13. /* Version 1.2 6-21-92                 */
  14. /* Adapted to play from within Chicago */
  15. /* version 1.3 by Matt English 6-6-92  */
  16. /***************************************/
  17.  
  18. CR='0D'x
  19. OPTIONS RESULTS
  20. CALL TIME('R')
  21. SIGNAL ON BREAK_C
  22. SIGNAL ON BREAK_E
  23.  
  24. /* Open the support library if it is not already open. */
  25. if ~show('L',"rexxsupport.library") then do
  26.     addlib('rexxsupport.library',0,-30,0)
  27.      end
  28.  
  29. if getclip('CHICMON') ~= '' then do
  30.    CHICGAME = 1
  31.    purse = getclip('CHICMON')
  32.    dollarsign = '$'
  33.    playstuff = 'CASH'
  34.    if getclip('CHICCOLOR') = 1 then do
  35.      red   = ''
  36.      black = ''
  37.      white = ''
  38.      rev   = ''
  39.      def   = ''
  40.      whred = ''
  41.      whblk = ''
  42.      ital  = ''
  43.      under = ''
  44.     end
  45.    else do
  46.      red   = ''
  47.      black = ''
  48.      white = ''
  49.      rev   = ''
  50.      def   = ''
  51.      whred = ''
  52.      whblk = ''
  53.      ital  = ''
  54.      under = ''
  55.     end
  56.    call pull
  57.   end
  58.  
  59. ARG name purse flag . secs .
  60. IF secs='' THEN secs=2600
  61. IF DATATYPE(flag,'N') & flag~=0 THEN
  62.   DO
  63.     dollarsign=''
  64.     playstuff='TIME SECONDS'
  65.   END
  66. ELSE
  67.   DO
  68.     dollarsign='$'
  69.     playstuff='CASH'
  70.   END
  71.  
  72. /**********************************************************************/
  73. /*                  ANSI.rexx                                         */
  74. /*                  Simple ANSI color escape function assignments     */
  75. /*--------------------------------------------------------------------*/
  76. /*                  James M. Cates Sept. 24 1990                      */
  77. /**********************************************************************/
  78.  
  79. red   = ""       /****************************************/
  80. black = ""       /* These just make life easier when you */
  81. white = ""       /* want some color output.              */
  82. rev   = ""        /****************************************/
  83. def   = ""
  84. whred = ""
  85. whblk = ""
  86. ital  = ""
  87. under = ""
  88.  
  89.  
  90. say ' 'CR
  91. say ' 'CR
  92. if purse>0 then
  93. say '                     Welcome back to the Casino!'CR
  94. else
  95. say '                       Welcome to the Casino!'CR
  96. say ' 'CR
  97. say rev'***********************************************************************'CR
  98. say '*   __       ___    _   __        __  _    __    _        _  ___ ___  *'CR
  99. say '*  /  \ |\ | |_    /_\ |__| |\/| |_  | \  |__\  /_\ |\ | | \  |   |   *'CR
  100. say '*  \__/ | \| |__  /   \|  \ |  | |__ |_/  |__/ /   \| \| |_/ _|_  |   *'CR
  101. say '*                                                                     *'CR
  102. say '*   Revision:  Version 1.2    6-21-92 By: Matt English                *'CR
  103. say '*   Revision:  Version 1.0       1990 By: James M. Cates III          *'CR
  104. say '*   Original:  Version 0.81      1989 By: M.Soucy and M.Fox           *'CR
  105. say '*                                                                     *'CR
  106. say '***********************************************************************'def||CR
  107. say ' 'CR
  108. say ' 'CR
  109. if purse>0 then call name
  110. say 'Do you need Instructions 'red'('def'Y'red'/'def'N'red')'def' ?'CR
  111. arg
  112. ans=readstr()
  113. do i = 1 to 100
  114. if ans = 'Y' then call inst
  115. else call name
  116. do i = 1 to 100
  117.  
  118. inst:
  119. say ' 'CR
  120. say ital'C''mon now, this is a simple game. You just follow my prompts.'CR
  121. say 'I''ll do all the real work, all you really have to do is place your bet.'CR
  122. say ' 'CR
  123. say 'The symbols for each slot are a bit funny, they are only symb-'CR
  124. say 'bolic, so don''t worry. I did not feel like doing ascii represen-'CR
  125. say 'ations of FRUIT...'def||CR
  126. call play
  127.  
  128. play:
  129. say ' 'CR
  130. say 'Do you want to play 'red'('def'Y'red'/'def'N'red')'def' ?'CR
  131. arg
  132. ans=readstr()
  133. if ans = 'Y' then call name
  134. if ans = 'N' then call death
  135. do i = 1 to 100
  136.  
  137. name:
  138. if purse <10 then purse = 100
  139. bet = 0
  140. Tl = 0
  141. Dl = 0
  142. call Pull
  143.  
  144. Pull:
  145. CALL checkBBS()
  146. say ' 'CR
  147. if purse = 0 then call rating
  148. if chicgame = 1 then do
  149.  prompt('  'red'How much cash would you like to bet? > $'def'')
  150.  bet=readstr()
  151.  end
  152. else do
  153.  prompt( "Purse =" dollarsign||red||purse||def"  Your bet please "red":"def"")
  154.  Bet=readstr()
  155.  end
  156. if bet > 500 then do
  157.  say ''cr
  158.  say' Sorry Bud, there''s a $500 dollar limit at this machine!'cr
  159.  call pull
  160.  end
  161. if Bet > purse then
  162.  do
  163. say ' 'CR
  164. say "Sorry "red||name||def" you can't bet over" dollarsign||red||purse||def||CR
  165. do i = 1 to 100
  166.  end
  167. call Pull
  168.  end
  169. else
  170.  if Bet = 0 | Bet < 0 then call whatthehell
  171. else
  172.  if Bet = '' | Bet = ' ' then call Pull
  173. else
  174. say ''cr
  175. say ital'Bet taken...'def||CR
  176. call slots
  177.  
  178. slots:
  179. say ital'Pulling lever for 'under'BIG' playstuff'!'def||CR
  180. call roll
  181. call roll
  182.  
  183. roll:
  184. odz=10
  185. x=OPEN(f,'RAM:DUMMY','W')
  186. CALL WRITELN(f,'DUMMY')
  187. CALL CLOSE(f)
  188. micros=STRIP(WORD(STATEF('RAM:DUMMY'),7))
  189. IF micros<100 THEN micros=micros+100
  190. micros=RIGHT(micros,3)
  191. slot1=(LEFT(micros,1)*(odz/10))%1
  192. slot2=(SUBSTR(micros,2,1)*(odz/10))%1
  193. slot3=(RIGHT(micros,1)*(odz/10))%1
  194. call stakes
  195.  
  196. stakes:
  197. if slot1 = 0 then slot1 = '/'
  198. if slot1 = 1 then slot1 = '@'
  199. if slot1 = 2 then slot1 = '?'
  200. if slot1 = 3 then slot1 = '&'
  201. if slot1 = 4 then slot1 = '^'
  202. if slot1 = 5 then slot1 = '_'
  203. if slot1 = 6 then slot1 = '+'
  204. if slot1 = 7 then slot1 = '%'
  205. if slot1 = 8 then slot1 = '*'
  206. if slot1 = 9 then slot1 = '!'
  207. if slot2 = 0 then slot2 = '/'
  208. if slot2 = 1 then slot2 = '@'
  209. if slot2 = 2 then slot2 = '?'
  210. if slot2 = 3 then slot2 = '&'
  211. if slot2 = 4 then slot2 = '^'
  212. if slot2 = 5 then slot2 = '_'
  213. if slot2 = 6 then slot2 = '+'
  214. if slot2 = 7 then slot2 = '%'
  215. if slot2 = 8 then slot2 = '*'
  216. if slot2 = 9 then slot2 = '!'
  217. if slot3 = 0 then slot3 = '/'
  218. if slot3 = 1 then slot3 = '@'
  219. if slot3 = 2 then slot3 = '?'
  220. if slot3 = 3 then slot3 = '&'
  221. if slot3 = 4 then slot3 = '^'
  222. if slot3 = 5 then slot3 = '_'
  223. if slot3 = 6 then slot3 = '+'
  224. if slot3 = 7 then slot3 = '%'
  225. if slot3 = 8 then slot3 = '*'
  226. if slot3 = 9 then slot3 = '!'
  227. call output
  228.  
  229. output:
  230. say ' 'CR
  231. say '      <'red slot1 def'>      <'red slot2 def'>      <'red slot3 def'>'CR
  232. call compare
  233.  
  234. compare:
  235. if slot1 = slot2 & slot1 ~= slot3 then call winner1
  236.  else
  237. if slot2 = slot3 & slot2 ~= slot1 then call winner1
  238.  else
  239. if slot1 = slot2 & slot1 = slot3 then call winner2
  240.  else purse = (purse - bet)
  241. if chicgame = 1 then do
  242.  say''cr
  243.  say '   Sorry, you just lost $'bet''cr
  244.  call chicexit
  245.  end
  246. call Pull
  247.  
  248. winner1:
  249. say whred'You won double your bet!'def||CR
  250. purse = purse + (bet * 2)
  251. if chicgame = 1 then do
  252.  say''cr
  253.  win = (bet * 2)
  254.  say'    You just won $'win' !'cr
  255.  call chicexit
  256.  end
  257. call Pull
  258.  
  259. winner2:
  260. say whred'You won TRIPLE your bet!'def||CR
  261. purse = purse + (bet * 3)
  262. if chicgame = 1 then do
  263.  say''cr
  264.  win = (bet * 3)
  265.  say'    You just won $'win' !'cr
  266.  call chicexit
  267.  end
  268. call Pull
  269.  
  270. whatthehell:
  271. prompt( 'Do you want to continue 'red'('def'Y'red'/'def'N'red')'def' ?')
  272. do i = 1 to 100
  273. ans=readstr()
  274. arg
  275. if ans = 'Y' then call Pull
  276.              else do
  277.               if chicgame ~=1 then call rating
  278.               if chicgame = 1 then call chicexit
  279.               end
  280.         end
  281.  
  282. chicexit:
  283.  say''cr
  284.  call setclip('CHICMON',purse)
  285.  exit
  286.  
  287. rating:
  288. if purse > 2000 then RATE = 'Mr. Trump! Your jet is waiting.'
  289. if purse > 1500 & purse <= 2000 then RATE = 'What city are you going to buy?'
  290. if purse > 1000 & purse <= 1500 then RATE = 'Your wallet is fat now!'
  291. if purse > 750 & purse <= 1000 then RATE = 'Pretty good.'
  292. if purse > 500 & purse <= 750 then RATE = 'Well, you did okay.'
  293. if purse > 250 & purse <= 500 then RATE = 'Er..stick to monopoly, eh?'
  294. if purse < 250 & purse >= 100 then RATE = 'You need help!'
  295. if purse < 100 then RATE = 'Hope you have enough for a cab home, sucker!'
  296. say ' '
  297. say 'You had 'dollarsign||red||purse||def' before you quit!'CR
  298. say 'Your rating is : 'ital RATE def||CR
  299. do i = 1 to 200
  300. end
  301.  
  302.  
  303. BREAK_C:
  304. BREAK_E:
  305. death:
  306. say ' 'CR
  307. say 'You made' dollarsign||red||purse||def' today!'CR
  308. say 'Goodbye, 'ital||name||def'.'CR
  309. say ' 'CR
  310. CALL SETCLIP('BBS_winnings',purse)
  311. exit
  312. end
  313.  
  314.  
  315. checkBBS:
  316. IF ADDRESS()~='BAUD' THEN RETURN 0
  317. IF TIME('E')>secs THEN SIGNAL death
  318. dcd
  319. IF RC=0 THEN SIGNAL death
  320. temp=secs-TIME('E')
  321. IF temp<120 THEN SAY '*** Only' temp 'seconds left! ***'CR
  322. RETURN 0
  323.  
  324. readstr: procedure
  325. str=''
  326. out=readch(STDIN)
  327.  call WRITECH(STDOUT,out)
  328.  do while out~=D2C(13)
  329.       if out=D2C(8) then do
  330.          str=SUBSTR(str,1,LENGTH(str)-1)
  331.          call WRITECH(STDOUT,' ')
  332.          call WRITECH(STDOUT,out)
  333.          end
  334.       else
  335.          str=INSERT(str,out)
  336.       out=readch(STDIN)
  337.       call WRITECH(STDOUT,out)
  338.     end
  339. say '0D'x
  340. return(UPPER(str))
  341.  
  342. prompt: procedure
  343. parse arg str
  344. writech(STDOUT,str)
  345. return 1
  346.  
  347. /* One_Armed_Bandit.rexx */
  348.